SetParametersFromDB Subroutine

SUBROUTINE SetParametersFromDB   & 
!
  (iniDB, model)

IMPLICIT NONE

! Arguments with intent(in):

TYPE (IniList), INTENT(IN) :: iniDB
INTEGER (KIND = short), INTENT(IN) :: model !infiltration model

!Local declaration:
CHARACTER (LEN = 1000) :: soilTypeFile
INTEGER (KIND = short) ::i, j, id

!------------end of declaration------------------------------------------------ 
CALL Catch ('info', 'SoilBalance: ', 'setting soil parameters from database: ', &
          argument = IniReadString('soil-types-file', iniDB) )

!load soil types
soilTypeFile = IniReadString('soil-types-file', iniDB)
CALL ReadSoilTypes (soilTypeFile)


! load soil type map
CALL GridByIni (iniDB, soilTypeMap, section = 'soil-type-map')


!Set parameter maps used by all models

!first allocate memory
CALL NewGrid (ksat, soilTypeMap) 
CALL NewGrid (thetar, soilTypeMap) 
CALL NewGrid (thetas, soilTypeMap)
CALL NewGrid (wiltingPoint, soilTypeMap)
CALL NewGrid (fieldCapacity, soilTypeMap)
CALL NewGrid (psdi, soilTypeMap)

!then assigh parameters
DO i = 1, soilTypeMap % idim
  DO j = 1, soilTypeMap % jdim
     IF (soilTypeMap % mat (i,j) /= soilTypeMap % nodata) THEN
       id = soilTypeMap % mat (i,j)
       ksat % mat (i,j) = soils (id) % ksat 
       thetar % mat (i,j) = soils (id) % thetar
       thetas % mat (i,j) = soils (id) % thetas
       wiltingPoint % mat (i,j) = soils (id) % wp
       fieldCapacity % mat (i,j) = soils (id) % fc
       psdi % mat (i,j) = soils (id) % psdi
     END IF
  END DO
END DO  

IF (model == SCS_CN) THEN !read supplementary parameters required by Curve Number 
  !first allocate memory
  CALL NewGrid (curveNumber, soilTypeMap) 
  CALL NewGrid (abstractionRatio, soilTypeMap)
  CALL NewGrid (storativity, soilTypeMap)
  
  !then assign parameters
  DO i = 1, soilTypeMap % idim
    DO j = 1, soilTypeMap % jdim
       IF (soilTypeMap % mat (i,j) /= soilTypeMap % nodata) THEN
         id = soilTypeMap % mat (i,j)
         curveNumber % mat (i,j) = soils (id) % cn 
         abstractionRatio % mat (i,j) = soils (id) % c
         storativity % mat (i,j) = soils (id) % s0
       END IF
    END DO
  END DO
END IF

IF (model == PHILIPEQ) THEN !read supplementary parameters required by Philips 
  !first allocate memory
  CALL NewGrid (psic, soilTypeMap) 
  
  !then assigh parameters
  DO i = 1, soilTypeMap % idim
    DO j = 1, soilTypeMap % jdim
       IF (soilTypeMap % mat (i,j) /= soilTypeMap % nodata) THEN
         id = soilTypeMap % mat (i,j)
         psic % mat (i,j) = soils (id) % psic 
       END IF
    END DO
  END DO
END IF

IF (model == GREEN_AMPT) THEN !read supplementary parameters required by Green Ampt 
  !first allocate memory
  CALL NewGrid (phy, soilTypeMap) 
  
  !then assigh parameters
  DO i = 1, soilTypeMap % idim
    DO j = 1, soilTypeMap % jdim
       IF (soilTypeMap % mat (i,j) /= soilTypeMap % nodata) THEN
         id = soilTypeMap % mat (i,j)
         phy % mat (i,j) = soils (id) % phy 
       END IF
    END DO
  END DO
END IF

IF (model == ROSS_BC) THEN !read supplementary parameters required by Ross Brooks and Corey 
  !first allocate memory
  CALL NewGrid (psic, soilTypeMap) 
  
  !then assigh parameters
  DO i = 1, soilTypeMap % idim
    DO j = 1, soilTypeMap % jdim
       IF (soilTypeMap % mat (i,j) /= soilTypeMap % nodata) THEN
         id = soilTypeMap % mat (i,j)
         psic % mat (i,j) = soils (id) % psic 
       END IF
    END DO
  END DO
END IF

IF (model == ROSS_VG) THEN !read supplementary parameters required by Ross Van Genuchten 
  !first allocate memory
  CALL NewGrid (psic, soilTypeMap) 
  CALL NewGrid (nvg, soilTypeMap) 
  CALL NewGrid (mvg, soilTypeMap) 
  CALL NewGrid (ptort, soilTypeMap)
  CALL NewGrid (ksatMatrix, soilTypeMap) 
  
  !then assigh parameters
  DO i = 1, soilTypeMap % idim
    DO j = 1, soilTypeMap % jdim
       IF (soilTypeMap % mat (i,j) /= soilTypeMap % nodata) THEN
         id = soilTypeMap % mat (i,j)
         psic % mat (i,j) = soils (id) % psic 
         nvg % mat (i,j) = soils (id) % n 
         mvg % mat (i,j) = soils (id) % m 
         mvg % mat (i,j) = soils (id) % m 
         ksatMatrix % mat (i,j) = soils (id) % kx
       END IF
    END DO
  END DO
END IF

RETURN
END SUBROUTINE SetParametersFromDB